home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0039_DOS Environment Unit.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-26  |  13KB  |  371 lines
  1. {
  2. From: MARIUS ELLEN
  3. Subj: DOS Environment
  4. }
  5.  
  6. Program Environment;
  7. {$M $1000,32776,32776 }
  8. {    1K stack, 32k+8 bytes heap }
  9. {$T- No @ Typed checking}
  10. {$X+ Extended function syntax}
  11. {$Q- No overflow checking}
  12. {$A+ Word align data}
  13. {$S+ Stack checking}
  14.  
  15. uses
  16.  
  17.     dos,
  18.     strings;
  19.  
  20. type
  21.  
  22.     PJFTRec = ^TJFTRec;
  23.     TJFTRec = record
  24.       JFTtable : array[1..20] of byte;
  25.     end;
  26.  
  27.  
  28.     PMCBrec = ^TMCBrec;
  29.     TMCBrec = record
  30.       Next     : char;      {4d "M", of 5a "Z"}
  31.       PSPOwner : word;
  32.       Length   : word;
  33.       Filler   : array[0..10] of byte;
  34.     end;
  35.  
  36.  
  37.     PPSPrec = ^TPSPrec;
  38.     TPSPrec = record       {ofs, length }
  39.       INT20   :word;       {00h  2 BYTEs   INT 20 instruction for CP/M CALL 0
  40.                                            program termination the CDh 20h
  41.                                            here is often used as a signature
  42.                                            for a valid PSP }
  43.       FreeSeg :word;       {02h    WORD    segment of first byte beyond
  44.                                            memory allocated to program}
  45.       UnUsed04:byte;       {04h    BYTE    unused filler }
  46.       CMPCall :byte;       {05h    BYTE    CP/M CALL 5 service request
  47.                                            (FAR JMP to 000C0h) BUG: (DOS 2+)
  48.                                            PSPs created by INT 21/AH=4Bh
  49.                                            point at 000BEh}
  50.       CPMSize :word;       {06h    WORD    CP/M compatibility--size of
  51.                                            first segment for .COM files}
  52.       CPMrem  :word;       {08h  2 BYTEs   remainder of FAR JMP at 05h}
  53.       INT22   :pointer;    {0Ah    DWORD   stored INT 22 termination address}
  54.       INT23   :pointer;    {0Eh    DWORD   stored INT 23 control-Break addr.}
  55.       INT24   :pointer;    {12h    DWORD   DOS 1.1+ stored INT 24 address}
  56.       ParPSP  :word;       {16h    WORD    segment of parent PSP}
  57.       JFT     :TJFTRec;    {18h 20 BYTEs   DOS 2+ Job File Table, one byte
  58.                                            per file handle, FFh = closed}
  59.       SEGEnv  :word;       {2Ch    WORD    DOS 2+ segment of environment
  60.                                            for process}
  61.       SSSP    :pointer;    {2Eh    DWORD   DOS 2+ process's SS:SP on entry
  62.                                            to last INT 21 call}
  63.       JFTCount:word;       {32h    WORD    DOS 3+ number of entries in JFT
  64.                                            (default is 20)}
  65.       JFTPtr  :pointer;    {34h    DWORD   DOS 3+ pointer to JFT
  66.                                            (default PSP:0018h)}
  67.       PrevPSP :pointer;    {38h    DWORD   DOS 3+ pointer to previous PSP
  68.                                            (default FFFFFFFFh in 3.x)
  69.                                            used by SHARE in DOS 3.3}
  70.       UnUsed3c:byte;       {3Ch    BYTE    apparently unused by DOS
  71.                                            versions <= 6.00}
  72.       UnUsed3d:byte;       {3Dh    BYTE    apparently used by some versions
  73.                                            of APPEND}
  74.       NovFlag :byte;       {3Eh    BYTE    (Novell NetWare) flag: next byte
  75.                                            initialized if CEh}
  76.       NovTask :byte;       {3Fh    BYTE    (Novell Netware) Novell task
  77.                                            number if previous byte is CEh}
  78.       DosVers :word;       {40h  2 BYTEs   DOS 5+ version to return on
  79.                                            INT 21/AH=30h}
  80.       NextPSP :word;       {42h    WORD    (MSWin3) selector of next PSP
  81.                                            (PDB) in linked list. Windows
  82.                                            keeps a linked list of Windows
  83.                                            programs only}
  84.       UnUsed44:pointer;    {44h  4 BYTEs   unused by DOS versions <= 6.00}
  85.       WinFlag :byte;       {48h    BYTE    (MSWindows3) bit 0 set if non-
  86.                                            Windows application (WINOLDAP)}
  87.       UnUsed49:string[6];  {49h  7 BYTEs   unused by DOS versions <= 6.00}
  88.       RETF21  :string[2];  {50h  3 BYTEs   DOS 2+ service request (INT
  89.                                            21/RETF instructions)}
  90.       UnUsed53:word;       {53h  2 BYTEs   unused in DOS versions <= 6.00}
  91.       UnUsed55:string[6];  {55h  7 BYTEs   unused in DOS versions <= 6.00;
  92.                                            can be used to make first FCB
  93.                                            into an extended FCB }
  94.       FCB1    :string[15]; {5Ch 16 BYTEs   first default FCB, filled in
  95.                                            from first commandline argument
  96.                                            overwrites second FCB if opened}
  97.       FCB2    :string[15]; {6Ch 16 BYTEs   second default FCB, filled in
  98.                                            from second commandline
  99.                                            argument, overwrites beginning
  100.                                            of commandline if opened}
  101.       UnUsed7c:pointer;    {7Ch  4 BYTEs   unused}
  102.       DTAArea :string[127];{80h 128 BYTEs  commandline / default DTA
  103.                                            command tail is BYTE for length
  104.                                            of tail, N BYTEs for the tail,
  105.                                            followed by a BYTE containing
  106.                                            0Dh}
  107.     end;
  108.  
  109.  
  110.     PMCBPSPrec = ^TMCBPSPrec;
  111.     TMCBPSPrec = record
  112.       MCB :TMCBRec;
  113.       PSP :TPSPRec;
  114.     end;
  115.  
  116. var
  117.  
  118.     MainEnvSeg:word;
  119.     MainEnvSize:word;
  120.  
  121.  
  122. {$ifndef TryAssembler}
  123.     {Find DOS master environment, command/4dos etc...}
  124.     procedure GetMainEnvironment(var envseg,envsize:word);
  125.     var R:PMCBPSPrec;
  126.       Rrec:array[0..1] of word absolute R;
  127.     begin
  128.       asm
  129.         mov     ah,52h            {Get First MCB, }
  130.         int     $21               {DOS Memory Control Block (MCB)}
  131.         mov     ax,es:[bx-2]      {Bevind zich 2 terug}
  132.         mov     R.word[0],0       {Offset is altijd 0}
  133.         mov     R.word[2],ax      {MCB:=first DOS mcb}
  134.       end;
  135.  
  136.       while true do begin
  137.         if pos(R^.mcb.next,'MZ')=0
  138.         then halt(7);             {Memory control block destroyed}
  139.  
  140.         if R^.mcb.PSPOwner=R^.PSP.ParPSP then begin {found}
  141.           EnvSeg :=R^.PSP.SegEnv;
  142.           R:=Ptr(EnvSeg-1,0);
  143.           EnvSize:=R^.mcb.length shl 4;
  144.           if EnvSize>32767
  145.           then halt(10);          {Environment invalid (usually >32K)}
  146.           exit;
  147.         end;
  148.         if R^.mcb.next='Z'
  149.         then halt(9);             {Memory block address invalid}
  150.                                   {Er moet een environment zijn!}
  151.         R:=ptr((Rrec[1]+(R^.mcb.length)+1),0);
  152.       end;
  153.     end;
  154.  
  155.  
  156. {$else}
  157.     procedure HaltIndirect(error:word);
  158.     begin
  159.       halt(error);
  160.     end;
  161.  
  162.  
  163.     {Find DOS master environment, command/4dos etc...}
  164.     procedure GetMainEnvironment(var envsegP,envsizeP:word);
  165.     assembler;
  166.     var mcb:pointer;
  167.     asm
  168.         mov     ah,52h            {Get First MCB, }
  169.         int     $21               {DOS Memory Control Block (MCB)}
  170.         sub     bx,2
  171.         xor     dx,dx             {offset altijd 0000}
  172.         mov     ax,es:[bx]
  173.         mov     mcb.word[0],dx
  174.         mov     mcb.word[2],ax    {MCB:=first DOS mcb}
  175.  
  176.     @repeat:
  177.         les     di,mcb
  178.         mov     bl,es:[di]
  179.         cmp     bl,4dH
  180.         je      @MCBOk
  181.         cmp     bl,5aH            {was het de laatste MCB}
  182.         jne     @MCBError         {zo ja dan halt(9)}
  183.     @MCBOk:
  184.         mov     ax,es:[01h]       {is segment v/h prg bij deze MCB}
  185.         cmp     ax,es:[26h]       {gelijk aan EnvSegment van het prg}
  186.         je      @found            {zo ja dan is ie gevonden}
  187.  
  188.         cmp     bl,5ah            {is dit de laatste mcb ?}
  189.         je      @MCBMissing       {!?!? MCB main env weg!?!?}
  190.         les     di,mcb            {volgende MCB zit op}
  191.         mov     ax,es             {oude MCB+next}
  192.         add     ax,es:[3]         {+volgende}
  193.         inc     ax                {+1}
  194.         mov     mcb.word[2],ax
  195.         jmp     @repeat           {herhaal tot gevonden}
  196.  
  197.     @MCBError:
  198.         mov     al,7              {Memory control block destroyed}
  199.         db      0a9h              {skip next mov al,xx=opcode test ax,w}
  200.     @MCBMissing:
  201.         mov     al,9              {Memory block address invalid}
  202.         db      0a9h              {kan ook environment not found zijn!}
  203.     @SizeErr:
  204.         mov     al,10             {Environment invalid (usually >32K)}
  205.         push    ax
  206.         call    HaltIndirect
  207.  
  208.     @found:
  209.         mov     ax,es:[3ch]       {Get segment environment}
  210.         mov     dx,es             {save es}
  211.         les     di,EnvSegP        {ptr van VAR parameter}
  212.         mov     es:[di],ax        {Store environment segment}
  213.         mov     es,dx             {rest es}
  214.  
  215.         dec     ax                {MCB van env. is 1 paragraaf terug}
  216.         mov     es,ax             {Get Size van env. uit MCB}
  217.         mov     ax,es:[3]         {deze is in paragrafen}
  218.         mov     cl,4              {en wordt geconverteerd}
  219.         shl     ax,cl             {naar bytes..}
  220.  
  221.         les     di,EnvSizeP       {ptr van VAR parameter}
  222.         mov     es:[di],ax        {Store environment size}
  223.         cmp     ax,32768          {size moet <32k}
  224.         jae     @SizeErr          {anders een foutmelding}
  225.     end;
  226. {$endif}
  227.  
  228.     {Seperate Variable and return parameters}
  229.     function StripEnvVariable(Variable:pchar):pchar;
  230.     const stop='='#32#0;
  231.     begin
  232.       While pos(Variable^,stop)=0 do inc(Variable);
  233.       StripEnvVariable:=Variable+1;
  234.       Variable^:=#0;
  235.     end;
  236.  
  237.  
  238.     {like bp's getenv, this time removing spaces}
  239.     function GetMainEnv(variable:string):string;
  240.     var MainPtr,Params:pchar;
  241.       data:array[0..512] of char;
  242.     begin
  243.       MainPtr:=ptr(MainEnvSeg,0);
  244.       StrPCopy(@variable,variable);
  245.       StrUpper(@variable);
  246.       StripEnvVariable(@variable);
  247.  
  248.       if variable[0]<>#0 then begin
  249.         while (MainPtr^<>#0) do begin
  250.           StrCopy(Data,MainPtr);
  251.           Params:=StripEnvVariable(data);
  252.           if StrComp(Data,@Variable)=0 then begin
  253.             GetMainEnv:=StrPas(Params);
  254.             exit;
  255.           end;
  256.           MainPtr:=StrEnd(MainPtr)+1;
  257.         end;
  258.       end;
  259.       GetMainEnv:='';
  260.     end;
  261.  
  262.  
  263.     {like bp's EnvCount}
  264.     function MainEnvCount:integer;
  265.     var MainPtr:pchar;
  266.       index:integer;
  267.     begin
  268.       index:=0;
  269.       MainPtr:=ptr(MainEnvSeg,0);
  270.       while (MainPtr^<>#0) do begin
  271.         MainPtr:=StrEnd(MainPtr)+1;
  272.         inc(index);
  273.       end;
  274.       MainEnvCount:=index;
  275.     end;
  276.  
  277.  
  278.     {like bp's EnvStr}
  279.     function MainEnvStr(index:integer):string;
  280.     var MainPtr:pchar;
  281.     begin
  282.       MainPtr:=ptr(MainEnvSeg,0);
  283.       while (MainPtr^<>#0) do begin
  284.         dec(index);
  285.         if index=0 then begin
  286.           MainEnvStr:=StrPas(MainPtr);
  287.           exit;
  288.         end;
  289.         MainPtr:=StrEnd(MainPtr)+1;
  290.       end;
  291.       MainEnvStr:='';
  292.     end;
  293.  
  294.  
  295.     {change environment "variable", returning succes}
  296.     function MainEnvChange(variable:string; param:string):boolean;
  297.     var data:array[0..512] of char;
  298.       Mem,MainPtr,EnvPtr:pchar;
  299.       NewSize:word absolute EnvPtr;
  300.       EnvPtrLong:^Longint absolute EnvPtr;
  301.  
  302.  
  303.       procedure EnvStrCopy(src:pchar);
  304.       begin
  305.         if NewSize+StrLen(src)<=MainEnvSize-4
  306.         then begin
  307.           StrCopy(EnvPtr,Src);
  308.           EnvPtr:=StrEnd(EnvPtr)+1;
  309.         end
  310.         else MainEnvChange:=false;
  311.       end;
  312.  
  313.       procedure PutVariable;
  314.       begin
  315.         if (Variable[0]<>#0) and (param[0]<>#0) then begin
  316.           StrCopy(Data,@variable);
  317.           StrCat(Data,'=');
  318.           StrCat(Data,@param);
  319.           EnvStrCopy(Data);
  320.           variable[0]:=#0;
  321.         end;
  322.       end;
  323.  
  324.     begin
  325.       getmem(Mem,MainEnvSize);
  326.       MainPtr:=ptr(MainEnvSeg,0);
  327.       EnvPtr:=Mem;
  328.  
  329.       StrPCopy(@variable,variable);
  330.       StrUpper(@variable);
  331.       StripEnvVariable(@variable);
  332.       StrPCopy(@param,param);
  333.       MainEnvChange:=variable[0]<>#0;
  334.  
  335.       while MainPtr^<>#0 do begin
  336.         StrCopy(Data,MainPtr);
  337.         StripEnvVariable(data);
  338.         if StrComp(Data,@Variable)=0
  339.         then PutVariable
  340.         else EnvStrCopy(MainPtr);
  341.         MainPtr:=StrEnd(MainPtr)+1;
  342.       end;
  343.  
  344.       if variable[0]<>#0
  345.       then PutVariable;
  346.  
  347.       EnvPtrLong^:=0; {4 terminating zero's}
  348.       {1 byte terminating environment}
  349.       {2 word counting trailing strings}
  350.       {1 byte terminating the strings}
  351.       {. last three disables paramstr(0)}
  352.       move(Mem^,Ptr(MainEnvSeg,0)^,NewSize+4);
  353.       freeMem(Mem,MainEnvSize);
  354.     end;
  355.  
  356.  
  357. var oldprmp:string;
  358. begin
  359.   GetMainEnvironment(MainEnvSeg,MainEnvSize);
  360.   memw[prefixseg:$2c]:=MainEnvSeg;
  361.  
  362.   oldprmp:=GetMainEnv('fprompt');
  363.   MainEnvChange('prompt','Please type EXIT!'#13#10+'$p$g');
  364.  
  365.   swapvectors;
  366.   exec(GetMainEnv('comspec'),'');
  367.   swapvectors;
  368.  
  369.   MainEnvChange('prompt',oldprmp);
  370. end.
  371.